Power Programmierung/Power-Programmierung (Tewi)(1994).iso/assemblr/library/edit/fremacsr/mintscan.asm

Assembly Source File | 1986-11-22 | 14KB | 505 lines

;History:90,26
    page    ,132

    .xlist
    include mintdefs.asm
    .list

HT    equ    9
LF    equ    10
CR    equ    13

data    segment byte public

comment /******************************************************************

Introduction:

    The MINT data structures are laid out in memory as given below.
First are the variables, followed by the neutral string.  Next is the
block of free memory.  Last is the active string followed by forms.

    variables, neutral string ... free memory ... neutral string, forms

The neutral string:

    The neutral string consists of a list of arguments.  Each argument
begins with header which might be laid out as so in Pascal:
    arg_header = record
     marker : (active_marker, neutral_marker, comma_marker);
     previous : ^arg_header;
    end;

The pointer, previous, points to the previous arg_header. The last one in the
list has a nil pointer.  This will always be the #(ps) which is the outermost
function to be executed.

The neutral string during function execution:

    Since we are interested in counting arguments from left to right,
not right to left, we need to reverse the pointers so that they point
from the first argument, to the second argument, to the third argument,
etc.  At this point, [fbgn] points to the first argument (the name of the
funciton), and [fend] points past the last argument.  To make argument
fetching more efficient, the last argument is followed by a null argument
which points to itself.  This causes missing arguments to be fetched as
nulls, in according to the definition of the language.
    Functions which return a value will build that value at either
[fbgn]-1 or [fend]-2, depending on whether or not they need to refer to
arguments supplied to the function.  In general, single argument functions
will use [fbgn]-1, and multiple argument functions will use [fend]-2.

Neutral function results will eventually be moved to [fbgn]-1.

The active string:

    The active string consists of a string of ASCII characters which
have not yet been scanned.  Typically, only ASCII characters appear here,
although any eight bit value may occur.

The active string during function execution:

    [actptr] points to the end of the active string.  Active function
results are built as described above and then moved to the left of [actptr].
Actptr is then adjusted to point to the result just moved in.  Primitives
check for memory overflow by comparing [fend] to [actptr].  If they come
closer than some magic constant, then the 'No Memory' error is given
and the idling string is reloaded.


The forms:

    Forms are laid out as a linear list of forms.  [formb] points to the
beginning, and [forme] points to the end.  The most recently defined forms are
placed at the beginning of the list.  The forms consists of three elements: a
header, the name, and the data.  The header contains the link to the next
form, the length of the name, the length of the data, and the form pointer
(which is always <= the length of the data).  The form structure is defined in
the file 'mintdefs.asm'.
    When a form is to be looked up in form storage, the form is first
hashed.  Then the form is looked up in the list of hash links.  A linear search
is performed for all the forms that hash to that value.



**************************************************************************/


    public    trace
    public    next_ids
    extrn    standard_ids: byte
    public    formb, forme, fbgn, fend, actptr
    extrn    lomem: byte

trace    db    0        ;trace is initially off.
next_ids    dw    standard_ids
formb    dw    ?
forme    dw    ?
fbgn    dw    ?
fend    dw    ?
actptr    dw    ?
fcn_save    db    ?
prev_fcn    dw    ?

;some constant definitions

;the _mark constants mark where a particular type of string occurs in
; the linked list.

comma_marker    equ    0    ;comma_marker must not have function_marker_mask set!
active_marker    equ    1    ;active_marker must have function_marker_mask set!
neutral_marker    equ    3    ;neutral_marker must have function_marker_mask set!
function_marker_mask    equ    1

entry    macro    char, adr
    org    (offset scan_xlat_table)+char
    db    (offset adr)-(offset scan_loop)
    endm

scan_xlat_table    db    256 dup ((offset scan_copy)-(offset scan_loop))
;first, fill up the table with 'copy'
;next, put the proper addresses in the right spots,
    entry    HT,scan_ignore
    entry    CR,scan_ignore
    entry    LF,scan_ignore
    entry    '#',scan_sharp
    entry    '(',scan_lpar
    entry    ')',scan_rpar
    entry    ',',scan_comma
;finally, go to the end of the table.
    org    (offset scan_xlat_table)+(size scan_xlat_table)

    purge    entry

    extrn    function_name_table: word
    extrn    function_name_length: word
    extrn    function_address: word

nomem_prompt        db    'No memory!',0
fatal_prompt        db    'No disk in drive or door open!',0
protected_prompt    db    'Disk is write protected!',0

    extrn    stackp: byte

data    ends


code    segment byte public

    assume    cs:code, ds:data, es:data

    public    abort_fatal
abort_fatal:
    add    sp,22            ;magic number from Z-DOS II, page I.3
    pop    es            ;restore our es and ds.
    push    es
    pop    ds
    mov    sp,offset stackp
    sti                ;enable interrupts again.
    mov    si,offset protected_prompt
    cmp    di,0            ;write protect?
    je    nomem_1
    mov    si,offset fatal_prompt
    jmp    short nomem_1
    public    nomem
nomem:
    mov    sp,offset stackp
    mov    si,offset nomem_prompt
nomem_1:
    lodsb
    or    al,al
    je    nomem_2
    mov    dl,al
    mov    ah,2
    int    21h
    jmp    nomem_1
nomem_2:
    jmp    init_ids

    extrn    init_ids: near

    public    init_ids_continue
init_ids_continue:
    mov    di,next_ids        ;get the desired idling string.
    mov    si,di            ;save a copy
    mov    next_ids,offset standard_ids    ;reset to ids.
    mov    al,0
    mov    cx,-1
    repne    scasb        ;find the terminating null.
    not    cx
    mov    di,formb
    sub    di,cx
    push    di
    rep    movsb
    pop    si        ;pushed as di
    mov    di,offset lomem
    mov    dx,0
    cld
    mov    bp,formb
    mov    bx,offset scan_xlat_table    ;->translate table
    jmp    short scan_loop
init_ids_jump_2:
    jmp    init_ids


comment /*******************************************************************
    The following is the MINT scan loop.  This loop must be as fast as
possible because it takes the most time to execute.   As a consequence, the
code is quite unstructured.  However, the code follows the algorithm given in
the MINT language definition document.
    During scan, si -> (points to) the active string, di -> the
neutral string, dx -> previous argument, and bp -> end of active string.
    As we scan a character, we must branch to certain routines on certain
characters.  To make best use of the 8086 instruction set, we have set up a
translate table.  Therefore, the translate table, scan_xlat_table, contains an
offset from the beginning of the scan loop.

    When the scan loop has finally found a function to be executed,
a jump is performed to that primitive (unknown primitives cause jump to dflt).
When the primitive is finished, it jumps (with the exception of hl) to one of
the 'return_???' functions.  Each of the return_??? routines puts the returned
value in the proper place in the proper string (active or neutral), and jumps
back to scan.
    The scan loop is repeatedly executed until there are no more functions
to be executed, or the available memory has been exhausted.
*****************************************************************************/

scan_copy:            ;come here to copy a char from active to neutral
    dec    si
    movsb
scan_ignore:            ;come here to throw a char away from active.
scan_loop:
    cmp    si,bp        ;if we scan off the right end, init_ids
    je    init_ids_jump_2
    lodsb
    xlat            ;al was char, is now offset
    cbw            ;ax is now offset.
    add    ax,offset scan_loop
    jmp    ax

scan_comma:
    mov    al,comma_marker
scan_mark:
    stosb            ;store marker
    mov    ax,dx        ;get previous pointer
    mov    dx,di        ;save current (will soon be previous)
    stosw
    jmp    scan_loop

scan_sharp:
    cmp    word ptr [si],'(#'    ;'##(' ?
    je    scan_two_sharps        ;yes.
    cmp    byte ptr [si],'('    ;'#(' ?
    jne    scan_copy        ;no.
    inc    si
    mov    al,active_marker
    jmp    scan_mark
scan_two_sharps:
    add    si,2
    mov    al,neutral_marker
    jmp    scan_mark

scan_lpar:
    mov    cx,1
    call    scan_lpar_sub
    jmp    scan_loop

;scan until we find a matching rpar.
    public    scan_lpar_sub        ;public so that we can profile it.
scan_lpar_sub:

scan_lpar_1:
    cmp    si,bp
    je    init_ids_jump_2
    lodsb            ;can't use movsb, because it doesn't load al
    stosb
    cmp    al,'('
    je    scan_lpar_2
    cmp    al,')'
    jne    scan_lpar_1
    loop    scan_lpar_1
    dec    di        ;remove final rpar
    ret
scan_lpar_2:
    inc    cx
    jmp    scan_lpar_1


init_ids_jump_1:    jmp    init_ids

scan_rpar:
;si -> neutral string
;di -> active string
;dx -> previous argument or function pointer.
    call    scan_rpar_sub
    call    function_address[di - 2]
    mov    bp,formb
    mov    bx,offset scan_xlat_table    ;->translate table
    jmp    scan_loop


    public    scan_rpar_sub
scan_rpar_sub:
;store last argument mark
    mov    al,comma_marker
    stosb
    mov    ax,di        ;make final arg -> itself
    stosw
comment !can't use slash***************************************************
    We have a problem here.  Currently, the pointers point backwards
to the previous function/arg.  We want this function's pointers to point
forwards, so we can start at the active/neutral marker and count arguments
forwards.

     ¥¥ is a pointer, ò is what is points to.


    a¥¥SS,¥¥ONE,¥¥TWO,¥¥
      ò   éò    éò    éò
      é   éé    éé    éé
      ¢¥¥¥Ü¢¥¥¥¥Üé    ¢Ü
             dx
**********************************************************************!
    mov    fend,di
    sub    di,2        ;make di ->final pointer
    mov    actptr,si
scan_rpar_1:
    cmp    dx,0        ;if end of list, we must be running off
    je    init_ids_jump_1    ; the left end (too many rpars)
    mov    bx,dx        ;get previous pointer.
    mov    dx,[bx]        ;get the current pointer [previous pointer].
    mov    [bx],di        ;store the next pointer.
    mov    di,bx        ;save current pointer.
; bx, di -> current arg/fcn
; dx -> previous (to the left) arg/fcn
    test    byte ptr -1[bx],function_marker_mask
    jz    scan_rpar_1
    mov    al,-1[bx]
    mov    fcn_save,al        ;remember the type of function.
    mov    prev_fcn,dx
    mov    fbgn,bx
    call    check_breakchar
    call    trace_invoke        ;destroys al
;remember that fbgn is really one more than the space taken by the function.
    mov    ax,[bx]            ;get pointer to first arg.
    sub    ax,bx            ;compute length of name
    cmp    ax,2 + mark_overhead    ;two character function name?
    jne    default_to_cl        ;no - must be default.
    mov    ax,2[bx]        ;get function name.
    mov    di,offset function_name_table
    mov    cx,offset function_name_length
    repne    scasw
    jne    default_to_cl        ;if not found, default
    sub    di,offset function_name_table
    ret
default_to_cl:
    mov    di,0
    ret

;return data routines here

    public    return_null
return_null:
    mov    cx,0
    call    trace_result    ;destroys al
return_nothing:
    mov    si,actptr
    mov    di,fbgn
    dec    di
    mov    dx,prev_fcn
    ret


    public    return_string
return_string:
;al=string number to return, bx=>list of strings.
    add    al,al
    mov    ah,0
    add    bx,ax
    mov    si,[bx]
    mov    cx,[bx+2]
    sub    cx,si
    jmp    return_sicx


    public    return_tos
return_tos:
;tos -> string, di -> byte after end of string
    pop    si
    mov    cx,di
    sub    cx,si
    jmp    short return_sicx


    public    return_arg_active
return_arg_active:
    mov    fcn_save,active_marker
;fall through to return_arg


    public    return_arg
return_arg:
;enter with cx = number of arg to return.
    call    getarg
;fall through to return_sicx


    public    return_sicx
return_sicx:
;si -> string, cx = count.
    cmp    fcn_save,active_marker    ;active or neutral
    jne    return_neutral
;    jmp    return_active        ;fall through!


    public    return_active
return_active:
;we need to move [si] count cx
; to [actptr-cx] through [actptr-1] reverse
;Then we return si = [actptr-cx], di=fbgn-1
    call    trace_result    ;destroys al
    jcxz    return_nothing    ;quick check for 0 chars.
    mov    di,actptr
    dec    di
    add    si,cx        ;point si to end of string + 1.
    dec    si        ;remember, it's postdecrement.
    std            ;reverse move
    rep    movsb
    cld            ;everybody assumes it's cleared.
    inc    di        ;make di -> last byte moved.
    mov    si,di        ;si -> what we just moved.
    mov    di,fbgn        ;remove previous function.
    dec    di
    mov    dx,prev_fcn
    ret

    public    return_neutral
return_neutral:
;we need to move [si] count cx
; to [fbgn-1] through [fbgn-1] - (cx - 1)
;Then we return si=actptr, di=[fbgn-1] - cx
    call    trace_result    ;destroys al
    jcxz    return_nothing    ;quick check for 0 chars.
    mov    di,fbgn
    dec    di
    cmp    di,si        ;is it there already?
    je    return_neutral_1    ;yes, save some time.
    rep    movsb        ;put it there.
return_neutral_1:
;tricky time!  If we performed the movsb, cx is zero, so we're doing
;nothing.  If we took the jump to return_neutral_1, cx is the proper
;count, so di will point to the right place.
    add    di,cx
    mov    si,actptr
    mov    dx,prev_fcn
    ret


    extrn    trace_result: near
    extrn    trace_invoke: near

;utility subroutines


    extrn    check_breakchar: near


    public    getarg1, getarg
getarg1:    mov    cx,1

;fall through to getarg

getarg:

;enter with cx = number of argument to get.
;exit with si -> argument, cx=length of argument.

comment /****************************************************************

The pointer after the last supplied argument points to itself, which allows
us to loop at getarg_loop until we think that we have found the argument.  Of
course, if that argument has not been supplied, all that we've done is to chase
the last pointer a few times.  As an aside, had you ever noticed that when the
amount of comments exceeds the amount of code, the code is likely to be
confusing?  Well, this code is probably confusing.

*************************************************************************/
    mov    si,fbgn
    jcxz    getarg_2    ;skip loop if count is zero.
getarg_loop:
    mov    si,[si]        ;get our argument
    loop    getarg_loop
getarg_2:
    mov    cx,[si]        ;get cx=next argument
    sub    cx,si        ;get cx=length of our argument
    jcxz    getarg_1    ;in case we ran into fend, it doesn't matter what si -> to.
    sub    cx,mark_overhead
    add    si,mark_overhead-1    ;make si-> text of argument.
getarg_1:
    ret

code    ends

    end